home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / MIDSQU.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  869b  |  36 lines
  1. PROCEDURE midsqu(aa,bb: real; VAR s: real; n: integer);
  2. (* Programs using MIDSQU must define the function to be integrated
  3. with the declaration FUNCTION func(x: real): real; They must also declare
  4. the global variable
  5. VAR
  6.    glit: integer; *)
  7. VAR
  8.    j: integer;
  9.    x,tnm,sum,del,ddel,b,a: real;
  10. FUNCTION funk(x: real): real;
  11.    BEGIN
  12.       funk := 2.0*x*func(bb-sqr(x))
  13.    END;
  14. BEGIN
  15.    b := sqrt(bb-aa);
  16.    a := 0.0;
  17.    IF (n = 1) THEN BEGIN
  18.       s := (b-a)*funk(0.5*(a+b));
  19.       glit := 1
  20.    END ELSE BEGIN
  21.       tnm := glit;
  22.       del := (b-a)/(3.0*tnm);
  23.       ddel := del+del;
  24.       x := a+0.5*del;
  25.       sum := 0.0;
  26.       FOR j := 1 TO glit DO BEGIN
  27.          sum := sum+funk(x);
  28.          x := x+ddel;
  29.          sum := sum+funk(x);
  30.          x := x+del
  31.       END;
  32.       s := (s+(b-a)*sum/tnm)/3.0;
  33.       glit := 3*glit
  34.    END
  35. END;
  36.